home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Shareware Grab Bag
/
Shareware Grab Bag.iso
/
001
/
pibt3sp4.arc
/
SETTRTAB.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1985-09-07
|
10KB
|
300 lines
(*----------------------------------------------------------------------*)
(* Set_Translate_Table --- Set Character Translation Table *)
(*----------------------------------------------------------------------*)
OVERLAY PROCEDURE Set_Translate_Table( File_Name : AnyStr );
(*----------------------------------------------------------------------*)
(* *)
(* Procedure: Set_Translate_Table *)
(* *)
(* Purpose: Gets character translation table *)
(* *)
(* Calling Sequence: *)
(* *)
(* Set_Translate_Table( File_Name : AnyStr ); *)
(* *)
(* File_Name --- file to read translate table from, if *)
(* specified. *)
(* *)
(* Calls: ClrScr *)
(* Save_Screen *)
(* Draw_Menu_Frame *)
(* Restore_Screen *)
(* Reset_Global_Colors *)
(* *)
(*----------------------------------------------------------------------*)
VAR
TrTab_File : TEXT;
TrTab_File_Name : AnyStr;
I : INTEGER;
J : INTEGER;
K : INTEGER;
L_Char : INTEGER;
H_Pos : INTEGER;
TrTab_Menu : Menu_Type;
Done : BOOLEAN;
Ch : CHAR;
TrTab_Base : INTEGER;
(*----------------------------------------------------------------------*)
(* Display_Translate_Table -- Display Translate_Table *)
(*----------------------------------------------------------------------*)
PROCEDURE Display_Translate_Table;
BEGIN (* Display_Translate_Table *)
GoToXY( 6 , 7 );
L_Char := 0;
FOR I := 0 TO 15 DO
BEGIN
GoToXY( 2 , I + 7 );
FOR J := 0 TO 7 DO
BEGIN
L_Char := ( J * 16 ) + I;
WRITE( ( TrTab_Base + L_Char):3, '=',
ORD(TrTab[CHR(L_Char + TrTab_Base)]):3,' ');
END;
END;
GoToXY( 6 , 7 );
END (* Display_Translate_Table *);
(*----------------------------------------------------------------------*)
BEGIN (* Set_Translate_Table *)
(* Announce translate table definition *)
Save_Screen( Saved_Screen );
Draw_Menu_Frame( 10, 10, 65, 15, Menu_Frame_Color,
Menu_Text_Color, 'Read Translate Table Definitions' );
WRITELN;
WRITE('File with definitions? ');
TrTab_File_Name := File_Name;
IF Length( TrTab_File_Name ) > 0 THEN
BEGIN
WRITE(TrTab_File_Name);
DELAY( One_Second_Delay );
END
ELSE
READLN( TrTab_File_Name );
IF LENGTH( TrTab_File_Name ) <= 0 THEN
BEGIN (* Get translation definitions from keyboard *)
(* Restore previous screen *)
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
Save_Screen( Saved_Screen );
Draw_Menu_Frame( 2, 1, 79, 24, Menu_Frame_Color,
Menu_Text_Color, 'Translate Table Definitions' );
ClrScr;
WRITELN(' Use arrows to move up/down/left/right.');
WRITELN(' Hit ESC to quit editing and save definitions.');
WRITELN(' To change character, just type new value, and hit CR.');
WRITELN(' Hit S to toggle between first and second 128 characters ');
(* Display current definitions *)
TrTab_Base := 0;
Display_Translate_Table;
Done := FALSE;
L_Char := 0;
I := 1;
J := 1;
H_Pos := 6;
(* Get new definitions *)
REPEAT
READ( Kbd, Ch );
IF ( Ch = CHR( ESC ) ) THEN
IF KeyPressed THEN
BEGIN (* Escape sequence found *)
READ( Kbd , Ch );
CASE ORD( Ch ) OF
72: IF L_Char > 0 THEN L_Char := L_Char - 1;
80: IF L_Char < 255 THEN L_Char := L_Char + 1;
77: IF ( L_Char + 16 ) < 255 THEN
L_Char := L_Char + 16;
75: IF ( L_Char - 16 ) > 0 THEN
L_Char := L_Char - 16;
ELSE ;
END (* CASE *);
I := L_Char DIV 16;
J := L_Char - ( I * 16 );
H_Pos := 6 + ( I * 9 );
GoToXY( H_Pos , J + 7 );
END (* Escape sequence found *)
ELSE (* Lone escape *)
Done := TRUE
(* "S" means toggle display *)
ELSE IF UpCase( Ch) = 'S' THEN
BEGIN
TrTab_Base := 128 - TrTab_Base;
Display_Translate_Table;
END
(* Should be digit *)
ELSE
BEGIN (* digit *)
K := 0;
WHILE( Ch <> CHR( CR ) ) DO
BEGIN
IF Ch IN ['0'..'9'] THEN
BEGIN
WRITE( Ch );
K := K * 10 + ORD( Ch ) - ORD('0');
END
ELSE IF Ch IN [CHR(BS), CHR(DEL)] THEN
BEGIN
IF WhereX > H_Pos THEN
BEGIN
GoToXY( WhereX - 1 , WhereY );
WRITE(' ');
GoToXY( WhereX - 1 , WhereY );
K := K DIV 10;
END;
END;
READ( Kbd , Ch );
END;
IF ( K >= 0 ) AND ( K <= 255 ) THEN
BEGIN
TrTab[CHR(L_Char + TrTab_Base)] := CHR(K);
GoToXY( H_Pos - 4 , J + 7 );
WRITE( ( TrTab_Base + L_Char):3, '=', K:3,' ');
END;
END (* Digit *);
UNTIL Done;
ClrScr;
GoToXY( 2 , 5 );
WRITE('Enter file name to write definitions to (CR to exit): ');
READLN( TrTab_File_Name );
IF LENGTH( TrTab_File_Name ) > 0 THEN
BEGIN
IF ( POS( '.', TrTab_File_Name ) = 0 ) THEN
TrTab_File_Name := TrTab_File_Name + '.TRA';
ASSIGN( TrTab_File , TrTab_File_Name );
(*$I-*)
REWRITE( TrTab_File );
(*$I+*)
IF Int24Result <> 0 THEN
BEGIN (* File bad *)
GoToXY( 2 , 5 );
WRITE('*** File ',TrTab_File_Name,' can''t be opened.');
ClrEol;
DELAY( Two_Second_Delay );
END (* File bad *)
ELSE
BEGIN (* File OK, definition written *)
FOR I := 0 TO 255 DO
WRITELN( TrTab_File, I:3, ' ', ORD(TrTab[CHR(I)]) );
CLOSE( TrTab_File );
GoToXY( 2 , 5 );
WRITE('Translation table definition written to ',
TrTab_File_Name );
ClrEol;
DELAY( Two_Second_Delay );
END (* File OK, definition written *);
END;
END (* Get translation table definition from keyboard *)
ELSE
BEGIN (* Get definition from file *)
IF ( POS( '.' , TrTab_File_Name ) = 0 ) THEN
TrTab_File_Name := TrTab_File_Name + '.TRA';
ASSIGN( TrTab_File , TrTab_File_Name );
(*$I-*)
RESET ( TrTab_File );
(*$I+*)
IF Int24Result <> 0 THEN
BEGIN (* File bad *)
WRITELN;
WRITELN('*** File ',TrTab_File_Name,' can''t be found.');
DELAY( Two_Second_Delay );
END (* File bad *)
ELSE
BEGIN (* File OK, read definition *)
REPEAT
(*$I-*)
READLN( TrTab_File , I, J );
(*$I+*)
IF Int24Result = 0 THEN
IF ( I >= 0 ) AND ( I <= 255 ) AND
( J >= 0 ) AND ( J <= 255 ) THEN
TrTab[CHR(I)] := CHR( J );
UNTIL( EOF( TrTab_File ) );
WRITELN('Translation table definition loaded.');
DELAY( Two_Second_Delay );
CLOSE( TrTab_File );
END (* File OK, read definition *);
END (* Get definition from file *);
(* Restore previous screen *)
Restore_Screen( Saved_Screen );
Reset_Global_Colors;
End (* Set_Translate_Table *);